home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / ButtonEx v22424782001.psc / ButtonEx.ctl next >
Encoding:
Visual Basic user-defined control file  |  2001-07-09  |  66.2 KB  |  1,845 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ButtonEx 
  3.    AutoRedraw      =   -1  'True
  4.    BackStyle       =   0  'Transparent
  5.    ClientHeight    =   1815
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   3345
  9.    DefaultCancel   =   -1  'True
  10.    OLEDropMode     =   1  'Manual
  11.    ScaleHeight     =   121
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   223
  14.    ToolboxBitmap   =   "ButtonEx.ctx":0000
  15.    Begin VB.PictureBox pictTempHighlight 
  16.       AutoRedraw      =   -1  'True
  17.       AutoSize        =   -1  'True
  18.       BorderStyle     =   0  'None
  19.       Height          =   495
  20.       Left            =   1800
  21.       ScaleHeight     =   495
  22.       ScaleWidth      =   1215
  23.       TabIndex        =   2
  24.       Top             =   240
  25.       Visible         =   0   'False
  26.       Width           =   1215
  27.    End
  28.    Begin VB.PictureBox pictTempDestination 
  29.       AutoRedraw      =   -1  'True
  30.       AutoSize        =   -1  'True
  31.       BorderStyle     =   0  'None
  32.       Height          =   495
  33.       Left            =   1800
  34.       ScaleHeight     =   495
  35.       ScaleWidth      =   1215
  36.       TabIndex        =   1
  37.       Top             =   960
  38.       Visible         =   0   'False
  39.       Width           =   1215
  40.    End
  41.    Begin VB.PictureBox imgPicture 
  42.       AutoRedraw      =   -1  'True
  43.       AutoSize        =   -1  'True
  44.       BorderStyle     =   0  'None
  45.       Height          =   495
  46.       Left            =   240
  47.       ScaleHeight     =   495
  48.       ScaleWidth      =   1215
  49.       TabIndex        =   0
  50.       Top             =   720
  51.       Visible         =   0   'False
  52.       Width           =   1215
  53.    End
  54.    Begin VB.Timer Timer1 
  55.       Enabled         =   0   'False
  56.       Interval        =   1
  57.       Left            =   720
  58.       Top             =   120
  59.    End
  60. End
  61. Attribute VB_Name = "ButtonEx"
  62. Attribute VB_GlobalNameSpace = False
  63. Attribute VB_Creatable = True
  64. Attribute VB_PredeclaredId = False
  65. Attribute VB_Exposed = False
  66. Option Explicit
  67. '****************************************************************
  68. '*  Copyright (C) Jeff Pearson 2001 - All Rights Reserved       *
  69. '*                                                              *
  70. '*  FILE:  ButtonEx.ctl                                         *
  71. '*                                                              *
  72. '*  DESCRIPTION:                                                *
  73. '*      Provides a enhanced CommandButton control, including    *
  74. '*      custom graphics as well MouseOver event, etc.           *
  75. '*                                                              *
  76. '*  CHANGE HISTORY:                                             *
  77. '*      Aug 2000    J. Pearson      Initial code                *
  78. '*      Sep 2000    J. Pearson      Release to PlanetSourceCode *
  79. '*      Jul 2001    J. Pearson      Updated to version 1.2      *
  80. '*                                  Added BorderStyle property  *
  81. '*                                  and other enhancements      *
  82. '****************************************************************
  83.  
  84. '//---------------------------------------------------------------------------------------
  85. '// Windows API constants
  86. '//---------------------------------------------------------------------------------------
  87. Private Const BLACKNESS = &H42              '(DWORD) dest = BLACK
  88. Private Const NOTSRCCOPY = &H330008         '(DWORD) dest = (NOT source)
  89. Private Const NOTSRCERASE = &H1100A6        '(DWORD) dest = (NOT src) AND (NOT dest)
  90. Private Const SRCAND = &H8800C6             '(DWORD) dest = source AND dest
  91. Private Const SRCCOPY = &HCC0020            '(DWORD) dest = source
  92. Private Const SRCERASE = &H440328           '(DWORD) dest = source AND (NOT dest )
  93. Private Const SRCINVERT = &H660046          '(DWORD) dest = source XOR dest
  94. Private Const SRCPAINT = &HEE0086           '(DWORD) dest = source OR dest
  95. Private Const WHITENESS = &HFF0062          '(DWORD) dest = WHITE
  96.  
  97. Private Const BDR_RAISEDINNER = &H4
  98. Private Const BDR_RAISEDOUTER = &H1
  99. Private Const BDR_SUNKENINNER = &H8
  100. Private Const BDR_SUNKENOUTER = &H2
  101.  
  102. Private Const BDR_RAISED = &H5
  103. Private Const BDR_OUTER = &H3
  104. Private Const BDR_INNER = &HC
  105.  
  106. Private Const BF_ADJUST = &H2000        'Calculate the space left over.
  107. Private Const BF_FLAT = &H4000          'For flat rather than 3-D borders.
  108. Private Const BF_MONO = &H8000          'For monochrome borders.
  109. Private Const BF_SOFT = &H1000          'Use for softer buttons.
  110. Private Const BF_BOTTOM = &H8
  111. Private Const BF_LEFT = &H1
  112. Private Const BF_RIGHT = &H4
  113. Private Const BF_TOP = &H2
  114. Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
  115.  
  116. Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
  117. Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
  118. Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
  119. Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
  120.  
  121. Private Const DT_CENTER = &H1
  122. Private Const DT_RTLREADING = &H20000
  123. Private Const DT_SINGLELINE = &H20
  124. Private Const DT_VCENTER = &H4
  125.  
  126. Private Const DST_COMPLEX = &H0
  127. Private Const DST_TEXT = &H1
  128. Private Const DST_PREFIXTEXT = &H2
  129. Private Const DST_ICON = &H3
  130. Private Const DST_BITMAP = &H4
  131.  
  132. Private Const DSS_NORMAL = &H0
  133. Private Const DSS_UNION = &H10                   '/* Gray string appearance */
  134. Private Const DSS_DISABLED = &H20
  135. Private Const DSS_RIGHT = &H8000
  136.  
  137. '//---------------------------------------------------------------------------------------
  138. '// Windows API types
  139. '//---------------------------------------------------------------------------------------
  140. Private Type POINTAPI
  141.     X As Long
  142.     Y As Long
  143. End Type
  144.  
  145. Private Type RECT
  146.     Left As Long
  147.     Top As Long
  148.     Right As Long
  149.     Bottom As Long
  150. End Type
  151.  
  152. '//---------------------------------------------------------------------------------------
  153. '// Windows API declarations
  154. '//---------------------------------------------------------------------------------------
  155. Private Declare Function BitBlt Lib "gdi32" (ByVal hdcDest As Long, ByVal xDest As Long, ByVal yDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hdcSrc As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As Long
  156. Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
  157. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  158. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
  159. Private Declare Function DrawEdge Lib "user32" (ByVal hDC As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
  160. Private Declare Function DrawFocusRect Lib "user32" (ByVal hDC As Long, lpRect As RECT) As Long
  161. Private Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hDC As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
  162. Private Declare Function DrawStateText Lib "user32" Alias "DrawStateA" (ByVal hDC As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As String, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
  163. Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
  164. Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
  165. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  166. Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
  167. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  168. Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
  169. Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
  170. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  171. Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
  172.  
  173. '//---------------------------------------------------------------------------------------
  174. '// Private enumerations
  175. '//---------------------------------------------------------------------------------------
  176. Private Enum StateConstants
  177.     btDown = 0
  178.     btUp = 1
  179.     btOver = 2
  180.     btDisabled = 3
  181.     btFocus = 4
  182. End Enum
  183.  
  184. Private Enum RasterOperationConstants
  185.     roNotSrcCopy = NOTSRCCOPY
  186.     roNotSrcErase = NOTSRCERASE
  187.     roSrcAnd = SRCAND
  188.     roSrcCopy = SRCCOPY
  189.     roSrcErase = SRCERASE
  190.     roSrcInvert = SRCINVERT
  191.     roSrcPaint = SRCPAINT
  192. End Enum
  193.  
  194. '//---------------------------------------------------------------------------------------
  195. '// Private constants
  196. '//---------------------------------------------------------------------------------------
  197. Private Const clTop As Long = 6
  198. Private Const clLeft As Long = 6
  199. Private Const clFocusOffset As Long = 4
  200. Private Const clDownOffset As Long = 1
  201.  
  202. '//---------------------------------------------------------------------------------------
  203. '// Private variables
  204. '//---------------------------------------------------------------------------------------
  205. Private tPrevEvent As String
  206. Private lState As StateConstants
  207. Private bLeftFocus As Boolean
  208. Private bHasFocus As Boolean
  209.  
  210. '//---------------------------------------------------------------------------------------
  211. '// Public constants
  212. '//---------------------------------------------------------------------------------------
  213. Public Enum AppearanceConstants
  214.     Flat = 0
  215.     [3D] = 1
  216.     Skin = 2
  217. End Enum
  218.  
  219. Public Enum BorderStyleConstants
  220.     None = 0
  221.     [Fixed Single] = 1
  222.     Bump = 2
  223.     Thin = 3
  224.     [Flat Border] = 4
  225. End Enum
  226.  
  227. Public Enum StyleConstants
  228.     Default = 0
  229.     ButtonGroup = 1
  230. End Enum
  231.  
  232. Public Enum ValueConstants
  233.     Down = 0
  234.     Up = 1
  235. End Enum
  236.  
  237. '//---------------------------------------------------------------------------------------
  238. '// Control property constants
  239. '//---------------------------------------------------------------------------------------
  240. Private Const m_def_AllowDefault = True
  241. Private Const m_def_AllowFocus = True
  242. Private Const m_def_Appearance = [3D]
  243. Private Const m_def_BackColor = vbButtonFace
  244. Private Const m_def_BorderStyle = [Fixed Single]
  245. Private Const m_def_Caption = "ButtonEx1"
  246. Private Const m_def_CaptionOffsetX = 0
  247. Private Const m_def_CaptionOffsetY = 0
  248. Private Const m_def_Enabled = True
  249. Private Const m_def_ForeColor = vbButtonText
  250. Private Const m_def_HighlightColor = vbButtonText
  251. Private Const m_def_HighlightPicture = False
  252. Private Const m_def_MousePointer = vbDefault
  253. Private Const m_def_OLEDropMode = vbOLEDropNone
  254. Private Const m_def_PictureOffsetX = 0
  255. Private Const m_def_PictureOffsetY = 0
  256. Private Const m_def_RightToLeft = False
  257. Private Const m_def_Style = 0
  258. Private Const m_def_ToolTipText = ""
  259. Private Const m_def_TransparentColor = vbBlue
  260. Private Const m_def_Value = Up
  261. Private Const m_def_WhatsThisHelpID = 0
  262.  
  263. '//---------------------------------------------------------------------------------------
  264. '// Control property variables
  265. '//---------------------------------------------------------------------------------------
  266. Private m_AllowDefault As Boolean
  267. Private m_AllowFocus As Boolean
  268. Private m_Appearance As AppearanceConstants
  269. Private m_BackColor As OLE_COLOR
  270. Private m_BorderStyle As BorderStyleConstants
  271. Private m_Caption As String
  272. Private m_CaptionOffsetX As Long
  273. Private m_CaptionOffsetY As Long
  274. Private m_Enabled As Boolean
  275. Private m_ForeColor As OLE_COLOR
  276. Private m_Font As Font
  277. Private m_HighlightColor As OLE_COLOR
  278. Private m_HighlightPicture As Boolean
  279. Private m_MouseIcon As Picture
  280. Private m_MousePointer As MousePointerConstants
  281. Private m_OLEDropMode As OLEDropConstants
  282. Private m_Picture As Picture
  283. Private m_PictureDisabled As Picture
  284. Private m_PictureDown As Picture
  285. Private m_PictureFocus As Picture
  286. Private m_PictureOffsetX As Long
  287. Private m_PictureOffsetY As Long
  288. Private m_PictureOver As Picture
  289. Private m_RightToLeft As Boolean
  290. Private m_SkinDisabled As Picture
  291. Private m_SkinDown As Picture
  292. Private m_SkinFocus As Picture
  293. Private m_SkinOver As Picture
  294. Private m_SkinUp As Picture
  295. Private m_Style As StyleConstants
  296. Private m_ToolTipText As String
  297. Private m_TransparentColor As OLE_COLOR
  298. Private m_Value As ValueConstants
  299. Private m_WhatsThisHelpID As Long
  300.  
  301. '//---------------------------------------------------------------------------------------
  302. '// Control property events
  303. '//---------------------------------------------------------------------------------------
  304. Public Event Click()
  305. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over the control."
  306. Public Event KeyDown(KeyCode As Integer, Shift As Integer)
  307. Attribute KeyDown.VB_Description = "Occurs when the user presses a key while the control has the focus."
  308. Public Event KeyPress(KeyAscii As Integer)
  309. Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
  310. Public Event KeyUp(KeyCode As Integer, Shift As Integer)
  311. Attribute KeyUp.VB_Description = "Occurs when the user releases a key while the control has the focus."
  312. Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  313. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while the control has the focus."
  314. Public Event MouseEnter()
  315. Attribute MouseEnter.VB_Description = "Occurs when the user moves the mouse over the control after MouseExit event."
  316. Public Event MouseExit()
  317. Attribute MouseExit.VB_Description = "Occurs when the user moves the mouse out of the control after MouseEnter event."
  318. Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  319. Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
  320. Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  321. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while the control has the focus."
  322. Public Event OLECompleteDrag(Effect As Long)
  323. Public Event OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
  324. Public Event OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
  325. Public Event OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean)
  326. Public Event OLESetData(Data As DataObject, DataFormat As Integer)
  327. Public Event OLEStartDrag(Data As DataObject, AllowedEffects As Long)
  328. Public Event Resize()
  329. Attribute Resize.VB_Description = "Occurs when a form is first displayed or the size of the control changes."
  330.  
  331. '//---------------------------------------------------------------------------------------
  332. '// Control properties
  333. '//---------------------------------------------------------------------------------------
  334.  
  335. Public Property Get AllowDefault() As Boolean
  336.     AllowDefault = m_AllowDefault
  337. End Property
  338.  
  339. Public Property Let AllowDefault(ByVal NewValue As Boolean)
  340.     m_AllowDefault = NewValue
  341.         
  342.     Call DrawButton(lState)
  343.     
  344.     PropertyChanged "AllowDefault"
  345. End Property
  346.  
  347. Public Property Get AllowFocus() As Boolean
  348.     AllowFocus = m_AllowFocus
  349. End Property
  350.  
  351. Public Property Let AllowFocus(ByVal NewValue As Boolean)
  352.     m_AllowFocus = NewValue
  353.         
  354.     Call DrawButton(lState)
  355.     
  356.     PropertyChanged "AllowFocus"
  357. End Property
  358.  
  359. Public Property Get Appearance() As AppearanceConstants
  360. Attribute Appearance.VB_Description = "Returns/sets whether or not the control is painted with 3-D effects."
  361.     Appearance = m_Appearance
  362. End Property
  363.  
  364. Public Property Let Appearance(ByVal NewValue As AppearanceConstants)
  365.     m_Appearance = NewValue
  366.         
  367.     Call DrawButton(lState)
  368.     
  369.     PropertyChanged "Appearance"
  370. End Property
  371.  
  372. Public Property Get BackColor() As OLE_COLOR
  373. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in the control."
  374.     BackColor = m_BackColor
  375. End Property
  376.  
  377. Public Property Let BackColor(ByVal NewValue As OLE_COLOR)
  378.     m_BackColor = NewValue
  379.     UserControl.BackColor = NewValue
  380.     imgPicture.BackColor = NewValue
  381.     
  382.     Call DrawButton(lState)
  383.     
  384.     PropertyChanged "BackColor"
  385. End Property
  386.  
  387. Public Property Get BorderStyle() As BorderStyleConstants
  388.     BorderStyle = m_BorderStyle
  389. End Property
  390.  
  391. Public Property Let BorderStyle(ByVal NewValue As BorderStyleConstants)
  392.     m_BorderStyle = NewValue
  393.     
  394.     Call DrawButton(lState)
  395.     
  396.     PropertyChanged "BorderStyle"
  397. End Property
  398.  
  399. Public Property Get Caption() As String
  400. Attribute Caption.VB_Description = "Returns/sets the text displayed in the control."
  401.     Caption = m_Caption
  402. End Property
  403.  
  404. Public Property Let Caption(ByVal NewValue As String)
  405.     Dim lPlace As Long
  406.     
  407.     m_Caption = NewValue
  408.     
  409.     'set access key
  410.     lPlace = 0
  411.     lPlace = InStr(lPlace + 1, NewValue, "&", vbTextCompare)
  412.     Do While lPlace <> 0
  413.         If Mid$(NewValue, lPlace + 1, 1) <> "&" Then
  414.             UserControl.AccessKeys = Mid$(NewValue, lPlace + 1, 1)
  415.             Exit Do
  416.         Else
  417.             lPlace = lPlace + 1
  418.         End If
  419.     
  420.         lPlace = InStr(lPlace + 1, NewValue, "&", vbTextCompare)
  421.     Loop
  422.     
  423.     Call DrawButton(lState)
  424.     
  425.     PropertyChanged "Caption"
  426. End Property
  427.  
  428. Public Property Get CaptionOffsetX() As Long
  429. Attribute CaptionOffsetX.VB_Description = "Returns/sets the horizontal offset for displaying the caption."
  430.     CaptionOffsetX = m_CaptionOffsetX
  431. End Property
  432.  
  433. Public Property Let CaptionOffsetX(ByVal NewValue As Long)
  434.     m_CaptionOffsetX = NewValue
  435.     
  436.     Call DrawButton(lState)
  437.     
  438.     PropertyChanged "CaptionOffsetX"
  439. End Property
  440.  
  441. Public Property Get CaptionOffsetY() As Long
  442. Attribute CaptionOffsetY.VB_Description = "Returns/sets the vertical offset for displaying the caption."
  443.     CaptionOffsetY = m_CaptionOffsetY
  444. End Property
  445.  
  446. Public Property Let CaptionOffsetY(ByVal NewValue As Long)
  447.     m_CaptionOffsetY = NewValue
  448.     
  449.     Call DrawButton(lState)
  450.     
  451.     PropertyChanged "CaptionOffsetY"
  452. End Property
  453.  
  454. Public Property Get Enabled() As Boolean
  455. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  456.     Enabled = m_Enabled
  457. End Property
  458.  
  459. Public Property Let Enabled(ByVal NewValue As Boolean)
  460.     m_Enabled = NewValue
  461.     UserControl.Enabled = NewValue
  462.     imgPicture.Enabled = NewValue
  463.     
  464.     If m_Enabled Then
  465.         lState = btUp
  466.     End If
  467.     Call DrawButton(lState)
  468.     
  469.     PropertyChanged "Enabled"
  470. End Property
  471.  
  472. Public Property Get ForeColor() As OLE_COLOR
  473. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in the control."
  474.     ForeColor = m_ForeColor
  475. End Property
  476.  
  477. Public Property Let ForeColor(ByVal NewValue As OLE_COLOR)
  478.     m_ForeColor = NewValue
  479.     UserControl.ForeColor = NewValue
  480.     imgPicture.ForeColor = NewValue
  481.     
  482.     Call DrawButton(lState)
  483.     
  484.     PropertyChanged "ForeColor"
  485. End Property
  486.  
  487. Public Property Get Font() As Font
  488. Attribute Font.VB_Description = "Returns/sets a Font object used to display text in the control."
  489.     Set Font = m_Font
  490. End Property
  491.  
  492. Public Property Set Font(ByVal NewValue As Font)
  493.     Set m_Font = NewValue
  494.     Set UserControl.Font = NewValue
  495.     Set imgPicture.Font = NewValue
  496.     
  497.     Call DrawButton(lState)
  498.     
  499.     PropertyChanged "Font"
  500. End Property
  501.  
  502. Public Property Get HighlightColor() As OLE_COLOR
  503. Attribute HighlightColor.VB_Description = "Returns/sets the highlight color used to display text and graphics when the mouse is over the control."
  504.     HighlightColor = m_HighlightColor
  505. End Property
  506.  
  507. Public Property Let HighlightColor(ByVal NewValue As OLE_COLOR)
  508.     m_HighlightColor = NewValue
  509.     
  510.     Call DrawButton(lState)
  511.     
  512.     PropertyChanged "HighlightColor"
  513. End Property
  514.  
  515. Public Property Get HighlightPicture() As Boolean
  516. Attribute HighlightPicture.VB_Description = "Returns/sets whether or not to highlight the object's picture with the HighlightColor."
  517.     HighlightPicture = m_HighlightPicture
  518. End Property
  519.  
  520. Public Property Let HighlightPicture(ByVal NewValue As Boolean)
  521.     m_HighlightPicture = NewValue
  522.     
  523.     Call DrawButton(btDisabled)
  524.     
  525.     PropertyChanged "HighlightPicture"
  526. End Property
  527.  
  528. Public Property Get hDC() As Long
  529.     hDC = UserControl.hDC
  530. End Property
  531.  
  532. Public Property Get hWnd() As Long
  533.     hWnd = UserControl.hWnd
  534. End Property
  535.  
  536. Public Property Get MouseIcon() As Picture
  537. Attribute MouseIcon.VB_Description = "Returns/sets a custom mouse icon."
  538.     Set MouseIcon = m_MouseIcon
  539. End Property
  540.  
  541. Public Property Set MouseIcon(ByVal NewValue As Picture)
  542.     Set m_MouseIcon = NewValue
  543.     Set UserControl.MouseIcon = NewValue
  544.     Set imgPicture.MouseIcon = NewValue
  545.     
  546.     PropertyChanged "MouseIcon"
  547. End Property
  548.  
  549. Public Property Get MousePointer() As MousePointerConstants
  550. Attribute MousePointer.VB_Description = "Returns/sets the type of mouse pointer displayed when over part of the control."
  551.     MousePointer = m_MousePointer
  552. End Property
  553.  
  554. Public Property Let MousePointer(ByVal NewValue As MousePointerConstants)
  555.     m_MousePointer = NewValue
  556.     UserControl.MousePointer = NewValue
  557.     imgPicture.MousePointer = NewValue
  558.     
  559.     PropertyChanged "MousePointer"
  560. End Property
  561.  
  562. Public Property Get OLEDropMode() As OLEDropConstants
  563.     OLEDropMode = m_OLEDropMode
  564. End Property
  565.  
  566. Public Property Let OLEDropMode(ByVal NewValue As OLEDropConstants)
  567.     m_OLEDropMode = NewValue
  568.     
  569.     PropertyChanged "OLEDropMode"
  570. End Property
  571.  
  572. Public Property Get Picture() As Picture
  573. Attribute Picture.VB_Description = "Returns/sets a graphic to be displayed in the control."
  574.     Set Picture = m_Picture
  575. End Property
  576.  
  577. Public Property Set Picture(ByVal NewValue As Picture)
  578.     Set m_Picture = NewValue
  579.     Set imgPicture.Picture = NewValue
  580.     
  581.     Call DrawButton(lState)
  582.     
  583.     PropertyChanged "Picture"
  584. End Property
  585.  
  586. Public Property Get PictureDisabled() As Picture
  587. Attribute PictureDisabled.VB_Description = "Returns/sets a graphic to be displayed in the control for the disabled state."
  588.     Set PictureDisabled = m_PictureDisabled
  589. End Property
  590.  
  591. Public Property Set PictureDisabled(ByVal NewValue As Picture)
  592.     Set m_PictureDisabled = NewValue
  593.     PropertyChanged "PictureDisabled"
  594. End Property
  595.  
  596. Public Property Get PictureDown() As Picture
  597.     Set PictureDown = m_PictureDown
  598. End Property
  599.  
  600. Public Property Set PictureDown(ByVal NewValue As Picture)
  601.     Set m_PictureDown = NewValue
  602.     PropertyChanged "PictureDown"
  603. End Property
  604.  
  605. Public Property Get PictureFocus() As Picture
  606.     Set PictureFocus = m_PictureFocus
  607. End Property
  608.  
  609. Public Property Set PictureFocus(ByVal New_PictureFocus As Picture)
  610.     Set m_PictureFocus = New_PictureFocus
  611.     PropertyChanged "PictureFocus"
  612. End Property
  613.  
  614. Public Property Get PictureOffsetX() As Long
  615. Attribute PictureOffsetX.VB_Description = "Returns/sets the horizontal offset for displaying the picture."
  616.     PictureOffsetX = m_PictureOffsetX
  617. End Property
  618.  
  619. Public Property Let PictureOffsetX(ByVal NewValue As Long)
  620.     m_PictureOffsetX = NewValue
  621.     
  622.     Call DrawButton(lState)
  623.     
  624.     PropertyChanged "PictureOffsetX"
  625. End Property
  626.  
  627. Public Property Get PictureOffsetY() As Long
  628. Attribute PictureOffsetY.VB_Description = "Returns/sets the vertical offset for displaying the picture."
  629.     PictureOffsetY = m_PictureOffsetY
  630. End Property
  631.  
  632. Public Property Let PictureOffsetY(ByVal NewValue As Long)
  633.     m_PictureOffsetY = NewValue
  634.     
  635.     Call DrawButton(lState)
  636.     
  637.     PropertyChanged "PictureOffsetY"
  638. End Property
  639.  
  640. Public Property Get PictureOver() As Picture
  641.     Set PictureOver = m_PictureOver
  642. End Property
  643.  
  644. Public Property Set PictureOver(ByVal New_PictureOver As Picture)
  645.     Set m_PictureOver = New_PictureOver
  646.     PropertyChanged "PictureOver"
  647. End Property
  648.  
  649. Public Property Get RightToLeft() As Boolean
  650. Attribute RightToLeft.VB_Description = "Determines text display direction and control visual appearance on a bidirectional system."
  651.     RightToLeft = m_RightToLeft
  652. End Property
  653.  
  654. Public Property Let RightToLeft(ByVal NewValue As Boolean)
  655.     m_RightToLeft = NewValue
  656.     UserControl.RightToLeft = NewValue
  657.     imgPicture.RightToLeft = NewValue
  658.     
  659.     Call DrawButton(lState)
  660.     
  661.     PropertyChanged "RightToLeft"
  662. End Property
  663.  
  664. Public Property Get SkinDisabled() As Picture
  665. Attribute SkinDisabled.VB_Description = "Returns/sets a graphic to be displayed for the control when it is disabled."
  666.     Set SkinDisabled = m_SkinDisabled
  667. End Property
  668.  
  669. Public Property Set SkinDisabled(ByVal NewValue As Picture)
  670.     Set m_SkinDisabled = NewValue
  671.     
  672.     Call DrawButton(lState)
  673.     
  674.     PropertyChanged "SkinDisabled"
  675. End Property
  676.  
  677. Public Property Get SkinDown() As Picture
  678. Attribute SkinDown.VB_Description = "Returns/sets a graphic to be displayed for the control the mouse has been pressed over it."
  679.     Set SkinDown = m_SkinDown
  680. End Property
  681.  
  682. Public Property Set SkinDown(ByVal NewValue As Picture)
  683.     Set m_SkinDown = NewValue
  684.     
  685.     Call DrawButton(lState)
  686.     
  687.     PropertyChanged "SkinDown"
  688. End Property
  689.  
  690. Public Property Get SkinFocus() As Picture
  691. Attribute SkinFocus.VB_Description = "Returns/sets a graphic to be displayed for the control when it default."
  692.     Set SkinFocus = m_SkinFocus
  693. End Property
  694.  
  695. Public Property Set SkinFocus(ByVal NewValue As Picture)
  696.     Set m_SkinFocus = NewValue
  697.     
  698.     Call DrawButton(lState)
  699.     
  700.     PropertyChanged "SkinFocus"
  701. End Property
  702.  
  703. Public Property Get SkinOver() As Picture
  704. Attribute SkinOver.VB_Description = "Returns/sets a graphic to be displayed for the control when the mouse is over it."
  705.     Set SkinOver = m_SkinOver
  706. End Property
  707.  
  708. Public Property Set SkinOver(ByVal NewValue As Picture)
  709.     Set m_SkinOver = NewValue
  710.     
  711.     Call DrawButton(lState)
  712.     
  713.     PropertyChanged "SkinOver"
  714. End Property
  715.  
  716. Public Property Get SkinUp() As Picture
  717. Attribute SkinUp.VB_Description = "Returns/sets a graphic to be displayed for the control."
  718.     Set SkinUp = m_SkinUp
  719. End Property
  720.  
  721. Public Property Set SkinUp(ByVal NewValue As Picture)
  722.     Set m_SkinUp = NewValue
  723.     
  724.     Call DrawButton(lState)
  725.     
  726.     PropertyChanged "SkinUp"
  727. End Property
  728.  
  729. Public Property Get Style() As StyleConstants
  730. Attribute Style.VB_Description = "Returns/sets the style for the control."
  731.     Style = m_Style
  732. End Property
  733.  
  734. Public Property Let Style(ByVal NewValue As StyleConstants)
  735.     m_Style = NewValue
  736.     
  737.     Call DrawButton(lState)
  738.     
  739.     PropertyChanged "Style"
  740. End Property
  741.  
  742. Public Property Get ToolTipText() As String
  743. Attribute ToolTipText.VB_Description = "Returns/sets the text displayed when the mouse cursor is over the control."
  744.     ToolTipText = m_ToolTipText
  745. End Property
  746.  
  747. Public Property Let ToolTipText(ByVal NewValue As String)
  748.     m_ToolTipText = NewValue
  749.     imgPicture.ToolTipText = NewValue
  750.     
  751.     PropertyChanged "ToolTipText"
  752. End Property
  753.  
  754. Public Property Get TransparentColor() As OLE_COLOR
  755. Attribute TransparentColor.VB_Description = "Returns/sets the color of the Picture property to make transparent."
  756.     TransparentColor = m_TransparentColor
  757. End Property
  758.  
  759. Public Property Let TransparentColor(ByVal NewValue As OLE_COLOR)
  760.     m_TransparentColor = NewValue
  761.     UserControl.MaskColor = NewValue
  762.     
  763.     Call DrawButton(lState)
  764.     
  765.     PropertyChanged "TransparentColor"
  766. End Property
  767.  
  768. Public Property Get Value() As ValueConstants
  769. Attribute Value.VB_Description = "Returns/sets a default state for the control."
  770.     Value = m_Value
  771. End Property
  772.  
  773. Public Property Let Value(ByVal NewValue As ValueConstants)
  774.     m_Value = NewValue
  775.     
  776.     Call DrawButton(m_Value)
  777.     
  778.     PropertyChanged "Value"
  779. End Property
  780.  
  781. Public Property Get WhatsThisHelpID() As Long
  782. Attribute WhatsThisHelpID.VB_Description = "Returns/sets an associated help context ID for the control."
  783.     WhatsThisHelpID = m_WhatsThisHelpID
  784. End Property
  785.  
  786. Public Property Let WhatsThisHelpID(ByVal NewValue As Long)
  787.     m_WhatsThisHelpID = NewValue
  788.     imgPicture.WhatsThisHelpID = NewValue
  789.     
  790.     PropertyChanged "WhatsThisHelpID"
  791. End Property
  792.  
  793. '//---------------------------------------------------------------------------------------
  794. '// Image functions
  795. '//---------------------------------------------------------------------------------------
  796.  
  797. Private Sub imgPicture_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  798.     Call UserControl_MouseDown(Button, Shift, imgPicture.Left + (X \ Screen.TwipsPerPixelX), imgPicture.Top + (Y \ Screen.TwipsPerPixelY))
  799. End Sub
  800.  
  801. Private Sub imgPicture_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  802.     Call UserControl_MouseMove(Button, Shift, imgPicture.Left + (X \ Screen.TwipsPerPixelX), imgPicture.Top + (Y \ Screen.TwipsPerPixelY))
  803. End Sub
  804.  
  805. Private Sub imgPicture_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  806.     Call UserControl_MouseUp(Button, Shift, imgPicture.Left + (X \ Screen.TwipsPerPixelX), imgPicture.Top + (Y \ Screen.TwipsPerPixelY))
  807. End Sub
  808.  
  809. '//---------------------------------------------------------------------------------------
  810. '// Timer functions
  811. '//---------------------------------------------------------------------------------------
  812.  
  813. Private Sub Timer1_Timer()
  814.     'check for mouse leaving control
  815.     Dim pnt As POINTAPI
  816.     
  817.     GetCursorPos pnt
  818.     ScreenToClient UserControl.hWnd, pnt
  819.     
  820.     If pnt.X < UserControl.ScaleLeft Or _
  821.             pnt.Y < UserControl.ScaleTop Or _
  822.             pnt.X > (UserControl.ScaleLeft + UserControl.ScaleWidth) Or _
  823.             pnt.Y > (UserControl.ScaleTop + UserControl.ScaleHeight) Then
  824.         Timer1.Enabled = False
  825.     
  826.         Call RaiseEventEx("MouseExit")
  827.         
  828.         'left focus
  829.         If lState <> btUp Then
  830.             Call DrawButton(btUp)
  831.         End If
  832.         bLeftFocus = True
  833.     
  834.     Else
  835.         'gained focus
  836.         If bLeftFocus Then
  837.             Call DrawButton(btDown)
  838.         End If
  839.     End If
  840. End Sub
  841.  
  842. '//---------------------------------------------------------------------------------------
  843. '// UserControl functions
  844. '//---------------------------------------------------------------------------------------
  845.  
  846. Private Sub UserControl_InitProperties()
  847.     'Initialize Properties for User Control
  848.     AllowDefault = m_def_AllowDefault
  849.     AllowFocus = m_def_AllowFocus
  850.     Appearance = m_def_Appearance
  851.     BackColor = m_def_BackColor
  852.     BorderStyle = m_def_BorderStyle
  853.     Caption = m_def_Caption
  854.     CaptionOffsetX = m_def_CaptionOffsetX
  855.     CaptionOffsetY = m_def_CaptionOffsetY
  856.     Enabled = m_def_Enabled
  857.     ForeColor = m_def_ForeColor
  858.     Set Font = Ambient.Font
  859.     HighlightColor = m_def_HighlightColor
  860.     HighlightPicture = m_def_HighlightPicture
  861.     Set MouseIcon = LoadPicture("")
  862.     MousePointer = m_def_MousePointer
  863.     OLEDropMode = m_def_OLEDropMode
  864.     Set Picture = LoadPicture("")
  865.     Set PictureDisabled = LoadPicture("")
  866.     Set PictureDown = LoadPicture("")
  867.     Set PictureFocus = LoadPicture("")
  868.     PictureOffsetX = m_def_PictureOffsetX
  869.     PictureOffsetY = m_def_PictureOffsetY
  870.     Set PictureOver = LoadPicture("")
  871.     RightToLeft = m_def_RightToLeft
  872.     Set SkinDisabled = LoadPicture("")
  873.     Set SkinDown = LoadPicture("")
  874.     Set SkinFocus = LoadPicture("")
  875.     Set SkinOver = LoadPicture("")
  876.     Set SkinUp = LoadPicture("")
  877.     Style = m_def_Style
  878.     ToolTipText = m_def_ToolTipText
  879.     TransparentColor = m_def_TransparentColor
  880.     Value = m_def_Value
  881.     WhatsThisHelpID = m_def_WhatsThisHelpID
  882. End Sub
  883.  
  884. Private Sub UserControl_OLECompleteDrag(Effect As Long)
  885.     RaiseEvent OLECompleteDrag(Effect)
  886. End Sub
  887.  
  888. Private Sub UserControl_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
  889.     RaiseEvent OLEDragDrop(Data, Effect, Button, Shift, X, Y)
  890. End Sub
  891.  
  892. Private Sub UserControl_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
  893.     RaiseEvent OLEDragOver(Data, Effect, Button, Shift, X, Y, State)
  894.     If State = vbEnter Then
  895.         Call DrawButton(btOver)
  896.     ElseIf State = vbLeave Then
  897.         Call DrawButton(btUp)
  898.     End If
  899. End Sub
  900.  
  901. Private Sub UserControl_OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean)
  902.     RaiseEvent OLEGiveFeedback(Effect, DefaultCursors)
  903. End Sub
  904.  
  905. Private Sub UserControl_OLESetData(Data As DataObject, DataFormat As Integer)
  906.     RaiseEvent OLESetData(Data, DataFormat)
  907. End Sub
  908.  
  909. Private Sub UserControl_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
  910.     RaiseEvent OLEStartDrag(Data, AllowedEffects)
  911. End Sub
  912.  
  913. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  914.     'Load property values from storage
  915.     AllowDefault = PropBag.ReadProperty("AllowDefault", m_def_AllowDefault)
  916.     AllowFocus = PropBag.ReadProperty("AllowFocus", m_def_AllowFocus)
  917.     Appearance = PropBag.ReadProperty("Appearance", m_def_Appearance)
  918.     BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
  919.     BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle)
  920.     Caption = PropBag.ReadProperty("Caption", m_def_Caption)
  921.     CaptionOffsetX = PropBag.ReadProperty("CaptionOffsetX", m_def_CaptionOffsetX)
  922.     CaptionOffsetY = PropBag.ReadProperty("CaptionOffsetY", m_def_CaptionOffsetY)
  923.     Enabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
  924.     ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
  925.     Set Font = PropBag.ReadProperty("Font", Ambient.Font)
  926.     HighlightColor = PropBag.ReadProperty("HighlightColor", m_def_HighlightColor)
  927.     HighlightPicture = PropBag.ReadProperty("HighlightPicture", m_def_HighlightPicture)
  928.     Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
  929.     MousePointer = PropBag.ReadProperty("MousePointer", m_def_MousePointer)
  930.     OLEDropMode = PropBag.ReadProperty("OLEDropMode", m_def_OLEDropMode)
  931.     Set Picture = PropBag.ReadProperty("Picture", Nothing)
  932.     Set PictureDisabled = PropBag.ReadProperty("PictureDisabled", Nothing)
  933.     Set PictureDown = PropBag.ReadProperty("PictureDown", Nothing)
  934.     Set PictureFocus = PropBag.ReadProperty("PictureFocus", Nothing)
  935.     PictureOffsetX = PropBag.ReadProperty("PictureOffsetX", m_def_PictureOffsetX)
  936.     PictureOffsetY = PropBag.ReadProperty("PictureOffsetY", m_def_PictureOffsetY)
  937.     Set PictureOver = PropBag.ReadProperty("PictureOver", Nothing)
  938.     RightToLeft = PropBag.ReadProperty("RightToLeft", m_def_RightToLeft)
  939.     Set SkinDisabled = PropBag.ReadProperty("SkinDisabled", Nothing)
  940.     Set SkinDown = PropBag.ReadProperty("SkinDown", Nothing)
  941.     Set SkinFocus = PropBag.ReadProperty("SkinFocus", Nothing)
  942.     Set SkinOver = PropBag.ReadProperty("SkinOver", Nothing)
  943.     Set SkinUp = PropBag.ReadProperty("SkinUp", Nothing)
  944.     Style = PropBag.ReadProperty("Style", m_def_Style)
  945.     ToolTipText = PropBag.ReadProperty("ToolTipText", m_def_ToolTipText)
  946.     TransparentColor = PropBag.ReadProperty("TransparentColor", m_def_TransparentColor)
  947.     Value = PropBag.ReadProperty("Value", m_def_Value)
  948.     WhatsThisHelpID = PropBag.ReadProperty("WhatsThisHelpID", m_def_WhatsThisHelpID)
  949. End Sub
  950.  
  951. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  952.     'Write property values to storage
  953.     Call PropBag.WriteProperty("AllowDefault", m_AllowDefault, m_def_AllowDefault)
  954.     Call PropBag.WriteProperty("AllowFocus", m_AllowFocus, m_def_AllowFocus)
  955.     Call PropBag.WriteProperty("Appearance", m_Appearance, m_def_Appearance)
  956.     Call PropBag.WriteProperty("Enabled", m_Enabled, m_def_Enabled)
  957.     Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
  958.     Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle)
  959.     Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
  960.     Call PropBag.WriteProperty("CaptionOffsetX", m_CaptionOffsetX, m_def_CaptionOffsetX)
  961.     Call PropBag.WriteProperty("CaptionOffsetY", m_CaptionOffsetY, m_def_CaptionOffsetY)
  962.     Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
  963.     Call PropBag.WriteProperty("Font", m_Font, Ambient.Font)
  964.     Call PropBag.WriteProperty("HighlightColor", m_HighlightColor, m_def_HighlightColor)
  965.     Call PropBag.WriteProperty("HighlightPicture", m_HighlightPicture, m_def_HighlightPicture)
  966.     Call PropBag.WriteProperty("OLEDropMode", m_OLEDropMode, m_def_OLEDropMode)
  967.     Call PropBag.WriteProperty("Picture", m_Picture, Nothing)
  968.     Call PropBag.WriteProperty("PictureDisabled", m_PictureDisabled, Nothing)
  969.     Call PropBag.WriteProperty("PictureDown", m_PictureDown, Nothing)
  970.     Call PropBag.WriteProperty("PictureFocus", m_PictureFocus, Nothing)
  971.     Call PropBag.WriteProperty("PictureOffsetX", m_PictureOffsetX, m_def_PictureOffsetX)
  972.     Call PropBag.WriteProperty("PictureOffsetY", m_PictureOffsetY, m_def_PictureOffsetY)
  973.     Call PropBag.WriteProperty("PictureOver", m_PictureOver, Nothing)
  974.     Call PropBag.WriteProperty("RightToLeft", m_RightToLeft, m_def_RightToLeft)
  975.     Call PropBag.WriteProperty("TransparentColor", m_TransparentColor, m_def_TransparentColor)
  976.     Call PropBag.WriteProperty("MouseIcon", m_MouseIcon, Nothing)
  977.     Call PropBag.WriteProperty("MousePointer", m_MousePointer, m_def_MousePointer)
  978.     Call PropBag.WriteProperty("SkinDisabled", m_SkinDisabled, Nothing)
  979.     Call PropBag.WriteProperty("SkinDown", m_SkinDown, Nothing)
  980.     Call PropBag.WriteProperty("SkinFocus", m_SkinFocus, Nothing)
  981.     Call PropBag.WriteProperty("SkinOver", m_SkinOver, Nothing)
  982.     Call PropBag.WriteProperty("SkinUp", m_SkinUp, Nothing)
  983.     Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
  984.     Call PropBag.WriteProperty("ToolTipText", m_ToolTipText, m_def_ToolTipText)
  985.     Call PropBag.WriteProperty("TransparentColor", m_TransparentColor, m_def_TransparentColor)
  986.     Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
  987.     Call PropBag.WriteProperty("WhatsThisHelpID", m_WhatsThisHelpID, m_def_WhatsThisHelpID)
  988. End Sub
  989.  
  990. Private Sub UserControl_Click()
  991.     Call RaiseEventEx("Click")
  992. End Sub
  993.  
  994. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  995.     Call RaiseEventEx("KeyDown", KeyCode, Shift)
  996. End Sub
  997.  
  998. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  999.     Call RaiseEventEx("KeyPress", KeyAscii)
  1000. End Sub
  1001.  
  1002. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  1003.     Call RaiseEventEx("KeyUp", KeyCode, Shift)
  1004. End Sub
  1005.  
  1006. Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
  1007.     Call RaiseEventEx("Click")
  1008. End Sub
  1009.  
  1010. Private Sub UserControl_AmbientChanged(PropertyName As String)
  1011.     If PropertyName = "DisplayAsDefault" Then
  1012.         If UserControl.Ambient.DisplayAsDefault Then
  1013.             bHasFocus = True
  1014.         Else
  1015.             bHasFocus = False
  1016.         End If
  1017.         Call DrawButton(lState)
  1018.     End If
  1019. End Sub
  1020.  
  1021. Private Sub UserControl_Initialize()
  1022.     'note: this really sets to 1215x375
  1023.     UserControl.Width = 1200
  1024.     UserControl.Height = 360
  1025. End Sub
  1026.  
  1027. Private Sub UserControl_GotFocus()
  1028.     bHasFocus = True
  1029.     Call DrawButton(lState)
  1030. End Sub
  1031.  
  1032. Private Sub UserControl_LostFocus()
  1033.     bHasFocus = False
  1034.     Call DrawButton(lState)
  1035. End Sub
  1036.  
  1037. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  1038.     bLeftFocus = False
  1039.     
  1040.     If Button = vbLeftButton Then
  1041.         If lState = btDown Then
  1042.             m_Value = Up
  1043.         Else
  1044.             m_Value = Down
  1045.         End If
  1046.         
  1047.         Call DrawButton(btDown)
  1048.     End If
  1049.     
  1050.     Call RaiseEventEx("MouseDown", Button, Shift, X * Screen.TwipsPerPixelX, Y * Screen.TwipsPerPixelY)
  1051. End Sub
  1052.  
  1053. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  1054.     bLeftFocus = False
  1055.     
  1056.     If UserControl.Ambient.UserMode = True And Not Timer1.Enabled Then
  1057.         'start tracking
  1058.         Timer1.Enabled = True
  1059.     
  1060.     ElseIf Button = 0 Then
  1061.         'mouse over (for flat button)
  1062.         If lState <> btOver Then
  1063.             Call DrawButton(btOver)
  1064.         End If
  1065.  
  1066.     ElseIf Button = vbLeftButton Then
  1067.         If lState <> btDown Then
  1068.             Call DrawButton(btDown)
  1069.         End If
  1070.     End If
  1071.  
  1072.     If X >= 0 And Y >= 0 And _
  1073.                 X <= UserControl.ScaleWidth And Y <= UserControl.ScaleHeight Then
  1074.         Call RaiseEventEx("MouseEnter")
  1075.         Call RaiseEventEx("MouseMove", Button, Shift, X * Screen.TwipsPerPixelX, Y * Screen.TwipsPerPixelY)
  1076.     End If
  1077. End Sub
  1078.  
  1079. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  1080.     bLeftFocus = False
  1081.     
  1082.     If Button = vbLeftButton Then
  1083.         Call DrawButton(btUp)
  1084.     End If
  1085.  
  1086.     Call RaiseEventEx("MouseUp", Button, Shift, X * Screen.TwipsPerPixelX, Y * Screen.TwipsPerPixelY)
  1087. End Sub
  1088.  
  1089. Private Sub UserControl_Resize()
  1090.     Call DrawButton(btUp)
  1091.     Call RaiseEventEx("Resize")
  1092. End Sub
  1093.  
  1094. '//---------------------------------------------------------------------------------------
  1095. '// Public methods
  1096. '//---------------------------------------------------------------------------------------
  1097.  
  1098. Public Sub ClearHighlight()
  1099.     Call DrawButton(lState)
  1100. End Sub
  1101.  
  1102. Public Sub DrawHighlight()
  1103.     'draw focus rect
  1104.     Dim rct As RECT
  1105.     Dim lPrevColor As Long
  1106.     
  1107.     With rct
  1108.         .Left = 0
  1109.         .Top = 0
  1110.         .Bottom = UserControl.ScaleHeight - 0
  1111.         .Right = UserControl.ScaleWidth - 0
  1112.     End With
  1113.     
  1114.     lPrevColor = UserControl.ForeColor
  1115.     UserControl.ForeColor = vbBlack
  1116.     Call DrawFocusRect(UserControl.hDC, rct)
  1117.     UserControl.ForeColor = lPrevColor
  1118.     
  1119.     UserControl.Refresh
  1120. End Sub
  1121.  
  1122. Public Sub Refresh()
  1123.     UserControl.Refresh
  1124. End Sub
  1125.  
  1126. Public Sub OLEDrag()
  1127.     UserControl.OLEDrag
  1128. End Sub
  1129.  
  1130. '//---------------------------------------------------------------------------------------
  1131. '// Private functions
  1132. '//---------------------------------------------------------------------------------------
  1133.  
  1134. Private Sub TransparentBlt_New2(ByVal hDC As Long, ByVal Source As PictureBox, ByRef DestPoint As POINTAPI, ByRef SrcPoint As POINTAPI, ByVal Width As Long, ByVal Height As Long, Optional ByVal TransparentColor As OLE_COLOR = -1, Optional ByVal Clear As Boolean = False, Optional ByVal Resize As Boolean = False, Optional ByVal Refresh As Boolean = False)
  1135.     Dim MonoMaskDC As Long
  1136.     Dim hMonoMask As Long
  1137.     Dim MonoInvDC As Long
  1138.     Dim hMonoInv As Long
  1139.     Dim ResultDstDC As Long
  1140.     Dim hResultDst As Long
  1141.     Dim ResultSrcDC As Long
  1142.     Dim hResultSrc As Long
  1143.     Dim hPrevMask As Long
  1144.     Dim hPrevInv As Long
  1145.     Dim hPrevSrc As Long
  1146.     Dim hPrevDst As Long
  1147.     Dim OldBC As Long
  1148.     
  1149.     If TransparentColor = -1 Then
  1150.         TransparentColor = GetPixel(Source.hDC, 1, 1)
  1151.     End If
  1152.     
  1153.     'create monochrome mask and inverse masks
  1154.     MonoMaskDC = CreateCompatibleDC(hDC)
  1155.     MonoInvDC = CreateCompatibleDC(hDC)
  1156.     hMonoMask = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
  1157.     hMonoInv = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
  1158.     hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
  1159.     hPrevInv = SelectObject(MonoInvDC, hMonoInv)
  1160.     
  1161.     'create keeper DCs and bitmaps
  1162.     ResultDstDC = CreateCompatibleDC(hDC)
  1163.     ResultSrcDC = CreateCompatibleDC(hDC)
  1164.     hResultDst = CreateCompatibleBitmap(hDC, Width, Height)
  1165.     hResultSrc = CreateCompatibleBitmap(hDC, Width, Height)
  1166.     hPrevDst = SelectObject(ResultDstDC, hResultDst)
  1167.     hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
  1168.     
  1169.     'copy src to monochrome mask
  1170.     OldBC = SetBkColor(Source.hDC, TransparentColor)
  1171.     Call BitBlt(MonoMaskDC, 0, 0, Width, Height, Source.hDC, SrcPoint.X, SrcPoint.Y, SRCCOPY)
  1172.     TransparentColor = SetBkColor(Source.hDC, OldBC)
  1173.     
  1174.     'create inverse of mask
  1175.     Call BitBlt(MonoInvDC, 0, 0, Width, Height, MonoMaskDC, 0, 0, NOTSRCCOPY)
  1176.     
  1177.     'get background
  1178.     Call BitBlt(ResultDstDC, 0, 0, Width, Height, hDC, DestPoint.X, DestPoint.Y, SRCCOPY)
  1179.     
  1180.     'AND with Monochrome mask
  1181.     Call BitBlt(ResultDstDC, 0, 0, Width, Height, MonoMaskDC, 0, 0, SRCAND)
  1182.     
  1183.     'get overlapper
  1184.     Call BitBlt(ResultSrcDC, 0, 0, Width, Height, Source.hDC, SrcPoint.X, SrcPoint.Y, SRCCOPY)
  1185.     
  1186.     'AND with inverse monochrome mask
  1187.     Call BitBlt(ResultSrcDC, 0, 0, Width, Height, MonoInvDC, 0, 0, SRCAND)
  1188.     
  1189.     'XOR these two
  1190.     Call BitBlt(ResultDstDC, 0, 0, Width, Height, ResultSrcDC, 0, 0, SRCINVERT)
  1191.     
  1192.     'output results
  1193.     Call BitBlt(hDC, DestPoint.X, DestPoint.Y, Width, Height, ResultDstDC, 0, 0, SRCCOPY)
  1194.     
  1195.     'clean up
  1196.     hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
  1197.     DeleteObject hMonoMask
  1198.     
  1199.     hMonoInv = SelectObject(MonoInvDC, hPrevInv)
  1200.     DeleteObject hMonoInv
  1201.     
  1202.     hResultDst = SelectObject(ResultDstDC, hPrevDst)
  1203.     DeleteObject hResultDst
  1204.     
  1205.     hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
  1206.     DeleteObject hResultSrc
  1207.     
  1208.     DeleteDC MonoMaskDC
  1209.     DeleteDC MonoInvDC
  1210.     DeleteDC ResultDstDC
  1211.     DeleteDC ResultSrcDC
  1212. End Sub
  1213.  
  1214. Private Function BitBltEx(ByVal Source As Object, ByVal Destination As Object, ByVal Operation As RasterOperationConstants, Optional ByVal xDest As Long = 0, Optional ByVal yDest As Long = 0, Optional ByVal XSrc As Long = 0, Optional ByVal YSrc As Long = 0, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional ByVal Refresh As Boolean = False) As Boolean
  1215.     Dim lReturn As Long
  1216.     
  1217.     If Width = -1 Then
  1218.         Width = Source.Width \ Screen.TwipsPerPixelX
  1219.     End If
  1220.     If Height = -1 Then
  1221.         Height = Source.Height \ Screen.TwipsPerPixelX
  1222.     End If
  1223.     
  1224.     'BitBlt
  1225.     lReturn = BitBlt(Destination.hDC, xDest, yDest, Width, Height, Source.hDC, XSrc, YSrc, Operation)
  1226.     
  1227.     If Refresh Then
  1228.         'refresh destination
  1229.         Destination.Refresh
  1230.     End If
  1231.     
  1232.     'return result
  1233.     If lReturn = 0 Then
  1234.         BitBltEx = False
  1235.     Else
  1236.         BitBltEx = True
  1237.     End If
  1238. End Function
  1239.  
  1240. Private Function MaskBltEx(ByVal Source As Object, ByVal Destination As Object, Optional ByVal MaskColor As OLE_COLOR = -1, Optional ByVal xDest As Long = 0, Optional ByVal yDest As Long = 0, Optional ByVal XSrc As Long = 0, Optional ByVal YSrc As Long = 0, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional ByVal Refresh As Boolean = False) As Boolean
  1241.     Dim MonoMaskDC As Long
  1242.     Dim hMonoMask As Long
  1243.     Dim MonoInvDC As Long
  1244.     Dim hMonoInv As Long
  1245.     Dim ResultDstDC As Long
  1246.     Dim hResultDst As Long
  1247.     Dim ResultSrcDC As Long
  1248.     Dim hResultSrc As Long
  1249.     Dim hPrevMask As Long
  1250.     Dim hPrevInv As Long
  1251.     Dim hPrevSrc As Long
  1252.     Dim hPrevDst As Long
  1253.     Dim OldBC As Long
  1254.     Dim lReturn As Long
  1255.     
  1256.     If Width = -1 Then
  1257.         Width = Source.Width \ Screen.TwipsPerPixelX
  1258.     End If
  1259.     If Height = -1 Then
  1260.         Height = Source.Height \ Screen.TwipsPerPixelX
  1261.     End If
  1262.     
  1263.     If MaskColor = -1 Then
  1264.         MaskColor = GetPixel(Source.hDC, 0, 0)
  1265.     End If
  1266.     
  1267.     'create monochrome mask and inverse masks
  1268.     MonoMaskDC = CreateCompatibleDC(Destination.hDC)
  1269.     hMonoMask = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
  1270.     hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
  1271.     
  1272.     'copy src to monochrome mask
  1273.     OldBC = SetBkColor(Source.hDC, MaskColor)
  1274.     lReturn = BitBlt(MonoMaskDC, 0, 0, Width, Height, Source.hDC, XSrc, YSrc, SRCCOPY)
  1275.     If lReturn <> 0 Then
  1276.         MaskColor = SetBkColor(Source.hDC, OldBC)
  1277.         
  1278.         'output results
  1279.         lReturn = BitBlt(Destination.hDC, xDest, yDest, Width, Height, MonoMaskDC, 0, 0, SRCCOPY)
  1280.     End If
  1281.     
  1282.     'clean up
  1283.     hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
  1284.     DeleteObject hMonoMask
  1285.     DeleteDC MonoMaskDC
  1286.  
  1287.     If Refresh Then
  1288.         'refresh destination
  1289.         Destination.Refresh
  1290.     End If
  1291.     
  1292.     'return result
  1293.     If lReturn = 0 Then
  1294.         MaskBltEx = False
  1295.     Else
  1296.         MaskBltEx = True
  1297.     End If
  1298. End Function
  1299.  
  1300. Private Function TransparentBltEx(ByVal Source As Object, ByVal Destination, Optional ByVal TransparentColor As OLE_COLOR = -1, Optional ByVal xDest As Long = 0, Optional ByVal yDest As Long = 0, Optional ByVal XSrc As Long = 0, Optional ByVal YSrc As Long = 0, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional ByVal Refresh As Boolean = False) As Boolean
  1301.     Dim MonoMaskDC As Long
  1302.     Dim hMonoMask As Long
  1303.     Dim MonoInvDC As Long
  1304.     Dim hMonoInv As Long
  1305.     Dim ResultDstDC As Long
  1306.     Dim hResultDst As Long
  1307.     Dim ResultSrcDC As Long
  1308.     Dim hResultSrc As Long
  1309.     Dim hPrevMask As Long
  1310.     Dim hPrevInv As Long
  1311.     Dim hPrevSrc As Long
  1312.     Dim hPrevDst As Long
  1313.     Dim OldBC As Long
  1314.     Dim lReturn As Long
  1315.     
  1316.     If Width = -1 Then
  1317.         Width = Source.Width \ Screen.TwipsPerPixelX
  1318.     End If
  1319.     If Height = -1 Then
  1320.         Height = Source.Height \ Screen.TwipsPerPixelX
  1321.     End If
  1322.     
  1323.     If TransparentColor = -1 Then
  1324.         TransparentColor = GetPixel(Source.hDC, 0, 0)
  1325.     End If
  1326.     
  1327.     'create monochrome mask and inverse masks
  1328.     MonoMaskDC = CreateCompatibleDC(Destination.hDC)
  1329.     MonoInvDC = CreateCompatibleDC(Destination.hDC)
  1330.     hMonoMask = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
  1331.     hMonoInv = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
  1332.     hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
  1333.     hPrevInv = SelectObject(MonoInvDC, hMonoInv)
  1334.     
  1335.     'create keeper DCs and bitmaps
  1336.     ResultDstDC = CreateCompatibleDC(Destination.hDC)
  1337.     ResultSrcDC = CreateCompatibleDC(Destination.hDC)
  1338.     hResultDst = CreateCompatibleBitmap(Destination.hDC, Width, Height)
  1339.     hResultSrc = CreateCompatibleBitmap(Destination.hDC, Width, Height)
  1340.     hPrevDst = SelectObject(ResultDstDC, hResultDst)
  1341.     hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
  1342.     
  1343.     'copy src to monochrome mask
  1344.     OldBC = SetBkColor(Source.hDC, TransparentColor)
  1345.     lReturn = BitBlt(MonoMaskDC, 0, 0, Width, Height, Source.hDC, XSrc, YSrc, SRCCOPY)
  1346.     If lReturn <> 0 Then
  1347.         TransparentColor = SetBkColor(Source.hDC, OldBC)
  1348.         
  1349.         'create inverse of mask
  1350.         lReturn = BitBlt(MonoInvDC, 0, 0, Width, Height, MonoMaskDC, 0, 0, NOTSRCCOPY)
  1351.         If lReturn <> 0 Then
  1352.             'get background
  1353.             lReturn = BitBlt(ResultDstDC, 0, 0, Width, Height, Destination.hDC, xDest, yDest, SRCCOPY)
  1354.             If lReturn <> 0 Then
  1355.                 'AND with Monochrome mask
  1356.                 lReturn = BitBlt(ResultDstDC, 0, 0, Width, Height, MonoMaskDC, 0, 0, SRCAND)
  1357.                 If lReturn <> 0 Then
  1358.                     'get overlapper
  1359.                     lReturn = BitBlt(ResultSrcDC, 0, 0, Width, Height, Source.hDC, XSrc, YSrc, SRCCOPY)
  1360.                     If lReturn <> 0 Then
  1361.                         'AND with inverse monochrome mask
  1362.                         lReturn = BitBlt(ResultSrcDC, 0, 0, Width, Height, MonoInvDC, 0, 0, SRCAND)
  1363.                         If lReturn <> 0 Then
  1364.                             'XOR these two
  1365.                             lReturn = BitBlt(ResultDstDC, 0, 0, Width, Height, ResultSrcDC, 0, 0, SRCINVERT)
  1366.                             If lReturn <> 0 Then
  1367.                                 'output results
  1368.                                 lReturn = BitBlt(Destination.hDC, xDest, yDest, Width, Height, ResultDstDC, 0, 0, SRCCOPY)
  1369.                             End If
  1370.                         End If
  1371.                     End If
  1372.                 End If
  1373.             End If
  1374.         End If
  1375.     End If
  1376.     
  1377.     'clean up
  1378.     hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
  1379.     DeleteObject hMonoMask
  1380.     
  1381.     hMonoInv = SelectObject(MonoInvDC, hPrevInv)
  1382.     DeleteObject hMonoInv
  1383.     
  1384.     hResultDst = SelectObject(ResultDstDC, hPrevDst)
  1385.     DeleteObject hResultDst
  1386.     
  1387.     hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
  1388.     DeleteObject hResultSrc
  1389.     
  1390.     DeleteDC MonoMaskDC
  1391.     DeleteDC MonoInvDC
  1392.     DeleteDC ResultDstDC
  1393.     DeleteDC ResultSrcDC
  1394.  
  1395.     If Refresh Then
  1396.         'refresh destination
  1397.         Destination.Refresh
  1398.     End If
  1399.     
  1400.     'return result
  1401.     If lReturn = 0 Then
  1402.         TransparentBltEx = False
  1403.     Else
  1404.         TransparentBltEx = True
  1405.     End If
  1406. End Function
  1407.  
  1408. Private Function HighlightBltEx(ByVal Source As Object, ByVal Destination, ByVal TempDestination As Object, ByVal Highlight As Object, ByVal HighlightColor As OLE_COLOR, Optional ByVal xDest As Long = 0, Optional ByVal yDest As Long = 0, Optional ByVal XSrc As Long = 0, Optional ByVal YSrc As Long = 0, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional ByVal Refresh As Boolean = False) As Boolean
  1409.     'highlight entire graphic with HighlightColor
  1410.     Highlight.BackColor = HighlightColor
  1411.     
  1412.     Call MaskBltEx(Source, TempDestination, -1, 0, 0, XSrc, YSrc, Width, Height)
  1413.     Call BitBltEx(TempDestination, Highlight, roSrcInvert, 0, 0, 0, 0, Width, Height)
  1414.     Call TransparentBltEx(Highlight, Destination, -1, xDest, yDest, 0, 0, Width, Height, Refresh)
  1415. End Function
  1416.  
  1417. Private Function RaiseEventEx(ByVal Name As String, ParamArray Params() As Variant)
  1418.     'raise event with specified parameters
  1419.     'don't allow duplicate MouseEnter and MouseExit events
  1420.         
  1421.     Select Case Name
  1422.         Case "Click"
  1423.             'click event occurred
  1424.             RaiseEvent Click
  1425.         
  1426.         Case "KeyDown"
  1427.             'key down event occurred
  1428.             RaiseEvent KeyDown(CInt(Params(0)), CInt(Params(1)))
  1429.         
  1430.         Case "KeyPress"
  1431.             'key press event occurred
  1432.             RaiseEvent KeyPress(CInt(Params(0)))
  1433.         
  1434.         Case "KeyUp"
  1435.             'key up event occurred
  1436.             RaiseEvent KeyUp(CInt(Params(0)), CInt(Params(1)))
  1437.         
  1438.         Case "MouseDown"
  1439.             'mouse down event occurred
  1440.             RaiseEvent MouseDown(CInt(Params(0)), CInt(Params(1)), CSng(Params(2)), CSng(Params(3)))
  1441.         
  1442.         Case "MouseMove"
  1443.             'mouse move event occurred
  1444.             RaiseEvent MouseMove(CInt(Params(0)), CInt(Params(1)), CSng(Params(2)), CSng(Params(3)))
  1445.         
  1446.         Case "MouseUp"
  1447.             'mouse up event occurred
  1448.             RaiseEvent MouseUp(CInt(Params(0)), CInt(Params(1)), CSng(Params(2)), CSng(Params(3)))
  1449.         
  1450.         Case "MouseExit"
  1451.             'mouse exit event occurred
  1452.             If tPrevEvent <> "MouseExit" Then
  1453.                 RaiseEvent MouseExit
  1454.             End If
  1455.     
  1456.             'save previous event (for MouseEnter and MouseExit events)
  1457.             tPrevEvent = Name
  1458.         
  1459.         Case "MouseEnter"
  1460.             'mouse enter event occurred
  1461.             If tPrevEvent <> "MouseEnter" Then
  1462.                 RaiseEvent MouseEnter
  1463.             End If
  1464.     
  1465.             'save previous event (for MouseEnter and MouseExit events)
  1466.             tPrevEvent = Name
  1467.         
  1468.         Case "Resize"
  1469.             'resize event occurred
  1470.             RaiseEvent Resize
  1471.     End Select
  1472. End Function
  1473.  
  1474. Private Sub DrawButton(ByVal State As StateConstants)
  1475.     'draw button around control
  1476.     Dim bFocus As Boolean
  1477.     Dim bUserMode As Boolean
  1478.     
  1479.     If tPrevEvent = "MouseExit" And State = btDown Then
  1480.         'prevents redrawing when outside control with mouse down
  1481.         Exit Sub
  1482.     End If
  1483.  
  1484.     'initialize variables
  1485.     bFocus = bHasFocus
  1486.     bUserMode = False
  1487.     Set UserControl.Picture = Nothing
  1488.     Set UserControl.MaskPicture = Nothing
  1489.     
  1490.     'clear control
  1491.     UserControl.Cls
  1492.     
  1493.     'get user mode
  1494.     On Local Error Resume Next
  1495.     bUserMode = UserControl.Ambient.UserMode
  1496.     On Local Error GoTo 0
  1497.     
  1498.     If m_Style = ButtonGroup Then
  1499.         'toggle button state
  1500.         If m_Value = Down Then
  1501.             State = btDown
  1502.         Else
  1503.             If State <> btOver Then
  1504.                 State = btUp
  1505.             End If
  1506.         End If
  1507.     End If
  1508.     
  1509.     If m_Appearance = Skin And Not (m_SkinUp Is Nothing) Then
  1510.         Call DrawSkin(State, bFocus And bUserMode)
  1511.     Else
  1512.         Call DrawStandard(State, bFocus And bUserMode)
  1513.     End If
  1514.     
  1515.     Call DrawPicture(State)
  1516.     Call DrawCaption(State)
  1517. End Sub
  1518.  
  1519. Private Sub DrawStandard(ByVal State As StateConstants, ByVal WithFocus As Boolean)
  1520.     'draw standard button (like CommandButton)
  1521.     Dim rct As RECT
  1522.     Dim lPrevColor As OLE_COLOR
  1523.     Dim lEdgeUp As Long
  1524.     Dim lEdgeDown As Long
  1525.     
  1526.     UserControl.BackStyle = 1
  1527.         
  1528.     Select Case m_BorderStyle
  1529.         Case Bump
  1530.             lEdgeUp = EDGE_BUMP
  1531.         Case Thin, [Flat Border]
  1532.             lEdgeUp = BDR_RAISEDINNER
  1533.         Case Else
  1534.             lEdgeUp = EDGE_RAISED
  1535.     End Select
  1536.     
  1537.     Select Case m_BorderStyle
  1538.         Case Bump
  1539.             lEdgeDown = EDGE_ETCHED
  1540.         Case Thin, [Flat Border]
  1541.             lEdgeDown = BDR_SUNKENOUTER
  1542.         Case Else
  1543.             lEdgeDown = EDGE_SUNKEN
  1544.     End Select
  1545.     
  1546.     'get rect
  1547.     With rct
  1548.         .Left = 0
  1549.         .Top = 0
  1550.         .Bottom = UserControl.ScaleHeight
  1551.         .Right = UserControl.ScaleWidth
  1552.     End With
  1553.     
  1554.     Select Case State
  1555.         Case btUp
  1556.             If m_Appearance = [3D] And m_BorderStyle <> None Then
  1557.                 'draw raised border
  1558.                 If WithFocus Then
  1559.                     If m_AllowDefault Then
  1560.                         Call DrawEdge(UserControl.hDC, rct, BDR_OUTER, BF_RECT Or BF_ADJUST Or BF_MONO)
  1561.                     End If
  1562.                 End If
  1563.                 Call DrawEdge(UserControl.hDC, rct, lEdgeUp, BF_RECT)
  1564.             
  1565.             ElseIf m_Appearance = Flat And m_BorderStyle = [Flat Border] Then
  1566.                 'draw thin border
  1567.                 If WithFocus Then
  1568.                     If m_AllowDefault Then
  1569.                         Call DrawEdge(UserControl.hDC, rct, BDR_OUTER, BF_RECT Or BF_ADJUST Or BF_MONO)
  1570.                     End If
  1571.                 End If
  1572.                     
  1573.                 lPrevColor = UserControl.ForeColor
  1574.                 UserControl.ForeColor = vbGrayText
  1575.                 
  1576.                 'manually draw rectangle around button
  1577.                 UserControl.Line (0, 0)-(rct.Right - 1, 0)
  1578.                 UserControl.Line (0, 0)-(0, rct.Bottom)
  1579.                 UserControl.Line (rct.Right - 1, 0)-(rct.Right - 1, rct.Bottom)
  1580.                 UserControl.Line (0, rct.Bottom - 1)-(rct.Right - 1, rct.Bottom - 1)
  1581.                 
  1582.                 UserControl.ForeColor = lPrevColor
  1583.             
  1584.             Else
  1585.                 WithFocus = False
  1586.             End If
  1587.         
  1588.         Case btOver
  1589.             'draw raised border
  1590.             If WithFocus Then
  1591.                 If m_AllowDefault Then
  1592.                     Call DrawEdge(UserControl.hDC, rct, BDR_OUTER, BF_RECT Or BF_ADJUST Or BF_MONO)
  1593.                 End If
  1594.             End If
  1595.             Call DrawEdge(UserControl.hDC, rct, lEdgeUp, BF_RECT)
  1596.         
  1597.         Case btDown
  1598.             'draw sunken border
  1599.             If m_BorderStyle <> None Then
  1600.                 If WithFocus Then
  1601.                     If m_AllowDefault Then
  1602.                         Call DrawEdge(UserControl.hDC, rct, BDR_OUTER, BF_RECT Or BF_ADJUST Or BF_MONO)
  1603.                         Call DrawEdge(UserControl.hDC, rct, BDR_SUNKENOUTER, BF_RECT Or BF_FLAT)
  1604.                     
  1605.                     Else
  1606.                         Call DrawEdge(UserControl.hDC, rct, lEdgeDown, BF_RECT)
  1607.                     End If
  1608.                 
  1609.                 Else
  1610.                     Call DrawEdge(UserControl.hDC, rct, lEdgeDown, BF_RECT)
  1611.                 End If
  1612.             End If
  1613.     End Select
  1614.  
  1615.     If m_AllowFocus Then
  1616.         If WithFocus Then
  1617.             'draw focus rect
  1618.             With rct
  1619.                 .Left = clFocusOffset
  1620.                 .Top = clFocusOffset
  1621.                 .Bottom = UserControl.ScaleHeight - clFocusOffset
  1622.                 .Right = UserControl.ScaleWidth - clFocusOffset
  1623.             End With
  1624.             
  1625.             lPrevColor = UserControl.ForeColor
  1626.             UserControl.ForeColor = vbBlack
  1627.             Call DrawFocusRect(UserControl.hDC, rct)
  1628.             UserControl.ForeColor = lPrevColor
  1629.         End If
  1630.     End If
  1631.     
  1632.     'set state
  1633.     lState = State
  1634. End Sub
  1635.  
  1636. Private Sub DrawSkin(ByVal State As StateConstants, ByVal WithFocus As Boolean)
  1637.     'draw button using skins
  1638.     
  1639.     'set state
  1640.     lState = State
  1641.     
  1642.     If Not m_Enabled Then
  1643.         State = btDisabled
  1644.         lState = State
  1645.     ElseIf WithFocus And State = btUp Then
  1646.         State = btFocus
  1647.     End If
  1648.  
  1649.     'set default picture
  1650.     UserControl.BackStyle = 0
  1651.     Set UserControl.Picture = m_SkinUp
  1652.     
  1653.     'set usercontrol picture
  1654.     Select Case State
  1655.         Case btDisabled
  1656.             If Not (m_SkinDisabled Is Nothing) Then
  1657.                 Set UserControl.Picture = m_SkinDisabled
  1658.             End If
  1659.         
  1660.         Case btDown
  1661.             If Not (m_SkinDown Is Nothing) Then
  1662.                 Set UserControl.Picture = m_SkinDown
  1663.             End If
  1664.         
  1665.         Case btUp
  1666.             Set UserControl.Picture = m_SkinUp
  1667.         
  1668.         Case btOver
  1669.             If Not (m_SkinOver Is Nothing) Then
  1670.                 Set UserControl.Picture = m_SkinOver
  1671.             End If
  1672.         
  1673.         Case btFocus
  1674.             If Not (m_SkinFocus Is Nothing) Then
  1675.                 Set UserControl.Picture = m_SkinFocus
  1676.             End If
  1677.     End Select
  1678.     
  1679.     If UserControl.Picture <> 0 Then
  1680.         'set mask picture
  1681.         Set UserControl.MaskPicture = UserControl.Picture
  1682.     
  1683.         'resize control
  1684.         UserControl.Width = UserControl.Picture.Width / 1.76
  1685.         UserControl.Height = UserControl.Picture.Height / 1.76
  1686.     End If
  1687. End Sub
  1688.  
  1689. Private Sub DrawCaption(ByVal State As StateConstants)
  1690.     'draw caption in button
  1691.     Dim lFormat As Long
  1692.     Dim lLeft As Long
  1693.     Dim lTop As Long
  1694.     Dim tCaption As String
  1695.     Dim lPlace As String
  1696.     
  1697.     'initialize variable
  1698.     If m_BorderStyle = [Flat Border] Then
  1699.         UserControl.ForeColor = vbGrayText
  1700.     Else
  1701.         UserControl.ForeColor = m_ForeColor
  1702.     End If
  1703.     
  1704.     Select Case State
  1705.         Case btOver
  1706.             UserControl.ForeColor = m_HighlightColor
  1707.         
  1708.         Case btDown
  1709.             If tPrevEvent <> "MouseExit" Then
  1710.                 UserControl.ForeColor = m_HighlightColor
  1711.             End If
  1712.     End Select
  1713.     
  1714.     'remove & when calculation caption position
  1715.     tCaption = m_Caption
  1716.     lPlace = InStr(1, tCaption, "&", vbTextCompare)
  1717.     If lPlace <> 0 Then
  1718.         tCaption = Left$(tCaption, lPlace - 1) & Mid$(tCaption, lPlace + 1)
  1719.     End If
  1720.     
  1721.     'calculate caption position
  1722.     If State = btDown And Not (m_Picture Is Nothing) Then
  1723.         lLeft = -1
  1724.     Else
  1725.         lLeft = 0
  1726.     End If
  1727.     lTop = -1
  1728.     
  1729.     If imgPicture.Picture <> 0 Then
  1730.         lLeft = lLeft + imgPicture.Left + imgPicture.Width
  1731.         lLeft = (((UserControl.ScaleWidth + lLeft) \ 2) - (UserControl.TextWidth(tCaption) \ 2))
  1732.     Else
  1733.         lLeft = lLeft + ((UserControl.ScaleWidth \ 2) - (UserControl.TextWidth(tCaption) \ 2))
  1734.     End If
  1735.     
  1736.     lTop = lTop + ((UserControl.ScaleHeight \ 2) - (UserControl.TextHeight(tCaption) \ 2))
  1737.     
  1738.     If State = btDown Then
  1739.         lLeft = lLeft + clDownOffset
  1740.         lTop = lTop + clDownOffset
  1741.     End If
  1742.     
  1743.     'draw caption in button
  1744.     lFormat = DST_PREFIXTEXT Or DSS_NORMAL
  1745.     If Not m_Enabled Then
  1746.         lFormat = lFormat Or DSS_DISABLED
  1747.     End If
  1748.     If m_RightToLeft Then
  1749.         lFormat = lFormat Or DSS_RIGHT
  1750.     End If
  1751.     
  1752.     Call DrawStateText(UserControl.hDC, 0, 0, m_Caption, Len(m_Caption), lLeft + m_CaptionOffsetX, lTop + m_CaptionOffsetY + clDownOffset, 0, 0, lFormat)
  1753. End Sub
  1754.  
  1755. Private Sub DrawPicture(ByVal State As StateConstants)
  1756.     'draw picture on button
  1757.     Dim lLeft As Long
  1758.     Dim lTop As Long
  1759.     Dim ptDest As POINTAPI
  1760.     Dim ptSrc As POINTAPI
  1761.     
  1762.     'set default picture
  1763.     Set imgPicture.Picture = m_Picture
  1764.     
  1765.     If Not m_Enabled Then
  1766.         State = btDisabled
  1767.     End If
  1768.     
  1769.     'set usercontrol picture
  1770.     Select Case State
  1771.         Case btDisabled
  1772.             If Not (m_PictureDisabled Is Nothing) Then
  1773.                 Set imgPicture.Picture = m_PictureDisabled
  1774.             End If
  1775.         
  1776.         Case btDown
  1777.             If Not (m_PictureDown Is Nothing) Then
  1778.                 Set imgPicture.Picture = m_PictureDown
  1779.             End If
  1780.         
  1781.         Case btUp
  1782.             Set imgPicture.Picture = m_Picture
  1783.         
  1784.         Case btOver
  1785.             If Not (m_PictureOver Is Nothing) Then
  1786.                 Set imgPicture.Picture = m_PictureOver
  1787.             End If
  1788.  
  1789.         Case btFocus
  1790.             If Not (m_PictureFocus Is Nothing) Then
  1791.                 Set imgPicture.Picture = m_PictureFocus
  1792.             End If
  1793.     End Select
  1794.     
  1795.     'move image
  1796.     With imgPicture
  1797.         If .Picture <> 0 Then
  1798.             If m_Appearance = Skin Then
  1799.                 lLeft = 0
  1800.                 lTop = (UserControl.ScaleHeight \ 2) - (.Height \ 2)
  1801.                 If lTop < 0 Then
  1802.                     lTop = 0
  1803.                 End If
  1804.             Else
  1805.                 lLeft = clLeft
  1806.                 lTop = (UserControl.ScaleHeight \ 2) - (.Height \ 2)
  1807.                 If lTop < clTop Then
  1808.                     lTop = clTop
  1809.                 End If
  1810.             End If
  1811.             
  1812.             If State = btDown Then
  1813.                 lLeft = lLeft + clDownOffset
  1814.                 lTop = lTop + clDownOffset
  1815.             End If
  1816.         
  1817.             lLeft = lLeft + m_PictureOffsetX
  1818.             lTop = lTop + m_PictureOffsetY
  1819.             
  1820.             If .Left <> lLeft Then
  1821.                 .Left = lLeft
  1822.             End If
  1823.             If .Top <> lTop Then
  1824.                 .Top = lTop
  1825.             End If
  1826.         
  1827.             ptDest.X = .Left
  1828.             ptDest.Y = .Top
  1829.             ptSrc.X = 0
  1830.             ptSrc.Y = 0
  1831.             
  1832.             If (State = btDown Or State = btOver Or (Not m_Enabled And State = btUp)) And m_HighlightPicture = True Then
  1833.                 If m_Enabled Then
  1834.                     Call HighlightBltEx(imgPicture, UserControl, pictTempDestination, pictTempHighlight, m_HighlightColor, .Left, .Top, 0, 0, .Width, .Height)
  1835.                 Else
  1836.                     Call HighlightBltEx(imgPicture, UserControl, pictTempDestination, pictTempHighlight, vbGrayText, .Left, .Top, 0, 0, .Width, .Height)
  1837.                 End If
  1838.             Else
  1839.                 Call TransparentBlt_New2(UserControl.hDC, imgPicture, ptDest, ptSrc, imgPicture.Width, imgPicture.Height, m_TransparentColor)
  1840.             End If
  1841.         End If
  1842.     End With
  1843. End Sub
  1844.  
  1845.